Crime Data Analysis

Author

Ju & Tim

Published

13.01.2025

Crime Data Analysis

Anmerkung: Mögliche Ungenauigkeiten, da die Daten von Papier Akten übertragen wurden

OCC = Occurrence

0. Beschreibung des Datensatzes

Der Datensatz crime data from 2020 to present enthält alle Berichte über beim Los Angeles Police Department (LAPD) registrierte Vorfälle in der Stadt Los Angeles (USA) vom 01.01.2020 bis zum 14.10.2024.

Dabei sind Informationen über die Tat, wie bis zu vier Tatbestände, die verwendete Tatwaffe, Tatzeitpunkt, Tatort, sowie eine Beschreibung der Art von Umgebung angegeben. Der Tatort ist dabei laut Metadaten auf den nächsten Hunderterblock gerundet, um die Anonymität zu wahren. Über das Opfer ist dabei das Alter, das Geschlecht und die Abstammung bekannt. Wobei als Abstammung Beschreibungen wie “Weiß”, “Schwarz”, “Chinesisch” oder ähnliches verwendet wird. Zusätzlich gibt es eine Spalte für den Modus Operandi, welcher meist Details über die Straftat oder den Täter enthält.

1. Definition/Formulierung der Fragestellung

Aufgabenstellung (10 Pkt.) X

Definieren Sie eine Sie interessierende bzw. interessante Fragestellung im Zusammenhang mit dem Datensatz:

  • Was interessiert Sie an dem Datensatz? X
  • Welche spezifische Fragestellung würden Sie gern mit Hilfe des Datensatzes beantworten? X
  • Was erwarten Sie, angesichts Ihrer Fragestellung, bezüglich des Datensatzes? X

// todo julia

  • Welche Klassen von Straftaten werden wie häufig begangen?
    • Anzahl Proportional zu Schweregrad
    • Viele Diebstahle & andere Straftaten um Geld zu beschaffen
  • Welche Stadtteile sind besonders betroffen?
    • Ärmere Stadtteile
    • Stadtteile mit Gang Gebieten
  • Welche Stadtteile haben besonders viele Straftaten mit Gang Einfluss?
    • Nicht Downtown & Beverly Hills (wohlhabendere Gegenden)
  • Welche Bevölkerungsgruppe ist am meisten gefährdet? (Abhängig von Alter, Geschlecht, Abstammung)
    • Junge Männer Schwarzer/Hispanischer Abstammung (weniger Wohlhaben + Gangs)
    • Junge weiße Frauen bei Sexualstraftaten
  • Gibt es besonders Gefährliche Arten von Orten ([Premise Desc])
    • Motels, Parking Lot, Street
    • Internet aka. Cyberspace
  • Welche Arten von Waffen wird am meisten genutzt?
    • Meistens nur unbewaffnet
    • Recht viele Schusswaffen
  • Wie viel Prozent haben zu Verhaftungen (und welcher Art) geführt?
    • Hoffentlich über 80%
  • Gibt es zeitliche Rahmen in denen mehr oder weniger Verbrechen geschehen?
    • Am meisten am Abend/in der Nacht
    • Anfang/Ende des Monats mehr Diebstahl/Raub? –> Gehalt auszahlung Diebstahl usw.?
    • Wochenenden -> Party etc
  • Wie effektiv ist die LAPD bei der Aufklärung verschiedener Arten von Straftaten?
    • Straftaten mit direktem Opfer mehr (Zeugen vorhanden)
  • Welche Straftaten werden häufig am Anfang/Ende des Monats begangen?
    • Gehalt auszahlung Diebstahl usw.?
  • Wie hat sich die Kriminalität über die 3 Jahre verändert?
    • In Corona deutlich abgenommen, ansonsten zugenommen

2. Laden der Daten

library(tibble)
library(readr)
library(tidyr)
library(dplyr)
library(ggplot2)
library(ggthemes)
library(purrr)
library(leaflet)
library(leaflet.extras)
library(plotly)
library(ggiraph)
library(forcats)
library(stringr)
rm(list = ls())

crimes.df.raw <- read_csv("Crime_Data_from_2020_to_Present.csv")
head(crimes.df.raw)
# A tibble: 6 × 28
      DR_NO `Date Rptd`    `DATE OCC` `TIME OCC` AREA  `AREA NAME` `Rpt Dist No`
      <dbl> <chr>          <chr>      <chr>      <chr> <chr>       <chr>        
1 190326475 03/01/2020 12… 03/01/202… 2130       07    Wilshire    0784         
2 200106753 02/09/2020 12… 02/08/202… 1800       01    Central     0182         
3 200320258 11/11/2020 12… 11/04/202… 1700       03    Southwest   0356         
4 200907217 05/10/2023 12… 03/10/202… 2037       09    Van Nuys    0964         
5 220614831 08/18/2022 12… 08/17/202… 1200       06    Hollywood   0666         
6 231808869 04/04/2023 12… 12/01/202… 2300       18    Southeast   1826         
# ℹ 21 more variables: `Part 1-2` <dbl>, `Crm Cd` <dbl>, `Crm Cd Desc` <chr>,
#   Mocodes <chr>, `Vict Age` <dbl>, `Vict Sex` <chr>, `Vict Descent` <chr>,
#   `Premis Cd` <dbl>, `Premis Desc` <chr>, `Weapon Used Cd` <dbl>,
#   `Weapon Desc` <chr>, Status <chr>, `Status Desc` <chr>, `Crm Cd 1` <dbl>,
#   `Crm Cd 2` <dbl>, `Crm Cd 3` <dbl>, `Crm Cd 4` <lgl>, LOCATION <chr>,
#   `Cross Street` <chr>, LAT <dbl>, LON <dbl>
# Welche Typen sind enthalten?
sapply(crimes.df.raw, class)
         DR_NO      Date Rptd       DATE OCC       TIME OCC           AREA 
     "numeric"    "character"    "character"    "character"    "character" 
     AREA NAME    Rpt Dist No       Part 1-2         Crm Cd    Crm Cd Desc 
   "character"    "character"      "numeric"      "numeric"    "character" 
       Mocodes       Vict Age       Vict Sex   Vict Descent      Premis Cd 
   "character"      "numeric"    "character"    "character"      "numeric" 
   Premis Desc Weapon Used Cd    Weapon Desc         Status    Status Desc 
   "character"      "numeric"    "character"    "character"    "character" 
      Crm Cd 1       Crm Cd 2       Crm Cd 3       Crm Cd 4       LOCATION 
     "numeric"      "numeric"      "numeric"      "logical"    "character" 
  Cross Street            LAT            LON 
   "character"      "numeric"      "numeric"

Einlesen der Modus Operandi Codes

mocodes.df.dirty <- read_delim("MO_CODES_Numerical_20191119.txt",
  delim = "\\s+",
  col_names = c("CodeBeschreibung"),
  trim_ws = TRUE
)

mocodes.df <- mocodes.df.dirty %>%
  separate(CodeBeschreibung,
    into = c("Code", "Beschreibung"),
    sep = "(?<=[0-9])\\s+",
    extra = "merge"
  ) %>%
  mutate(Code = as.integer(Code))

Hinzufügen von Straftat Klassifikationen

Die Seite der Datenquelle verlinkt zusätzlich auf ein Dokument, welches die Straftaten zu bestimmten Klassifikationen zuordnet. Dieses Klassifikationen des Dokuments werden hier eingelesen.

crmcd.categories <- read_csv("crmcd_categories.csv")

Da die Quelle nicht für alle Codes der Straftaten Klassifikationen zur Verfügung stellt wurden diese zusätzlich auf Grund der Beschreibungen erstellt und werden hier eingelesen.

missing_categories <- read_csv("missing_categories.csv")

Analyse Rohdaten

Modus Operandi:

Der Datensatz enthält eine Spalte mit MoCodes, welche eine Liste an Zahlen enthält. Diese Zahlen sind IDs des Mocodes Datensatzes, welcher den Modus Operandi als Beschreibung enthält.

Format des Datums

Das Datum ist standardmäßig im Format MM/DD/YYYY HH:MM:SS AM/PM angegeben. Jedoch enthalten die Datumsspalten keine Uhrzeit, diese ist, wenn vorhanden, separat angegeben.

Char fälschlicherweise als Datentyp

Die folgenden Datentypen sind fäschlicherweise als Char abgespeichert:

Spaltenname Spaltenbeschreibung Passender Datentyp
Date Prtd Meldedatum Date
Date OCC Verbrechensdatum Date
Time OCC Verbrechensuhrzeit Integer
Area Zugeordneter Bereich Integer
Rpt Dist No Bezirk des Verbrechens Integer
Mocodes Liste an Modus Operandi Codes List

Der passende Code wird im Abschnitt der Transformation verbessert.

Spalten mit fehlenden Werten (NAs)

na_counts <- colSums(is.na(crimes.df.raw))
print(na_counts)
         DR_NO      Date Rptd       DATE OCC       TIME OCC           AREA 
             0              0              0              0              0 
     AREA NAME    Rpt Dist No       Part 1-2         Crm Cd    Crm Cd Desc 
             0              0              0              0              0 
       Mocodes       Vict Age       Vict Sex   Vict Descent      Premis Cd 
        146435              0         139575         139586             14 
   Premis Desc Weapon Used Cd    Weapon Desc         Status    Status Desc 
           585         660132         660132              1              0 
      Crm Cd 1       Crm Cd 2       Crm Cd 3       Crm Cd 4       LOCATION 
            11         917588         984190         986500              0 
  Cross Street            LAT            LON 
        834230              0              0

In manchen Spalten befinden sich NAs, dazu gehören Informationen über:

  • Waffen
  • Modus Operandi
  • Geschlecht oder Abstammung des Opfers
  • Den Tatort
  • Zusätzliche Straftaten

Es ist jedoch zu erwarten, dass diese Spalten nicht in jedem Fall einen Wert haben, da sie nicht auf jede Straftat zu treffen. So ist es beispielsweise normal, dass nicht jede Straftat mit einer Waffe begangen wird.

Überprüfung Aussagen der Metadaten:

  • “Crm Cd should be the same as Crm Cd 1”

    Crm Cd 1 sollte die gleichen Werte wie Crm Cd haben:

    Crm Cd Indicates the crime committed. (Same as Crime Code 1)

    Diese Aussage wird in der Aufarbeitung überprüft.

  • Keine Information über Part 1-2

    Da es keine Informationen über die Bedeutung der Spalte Part 1-2 gibt, wird diese im folgenden Abschnitt entfernt.

  • Die Codes für Straftaten, Bezirke und Ortsbeschreibungen entsprechen jeweils einer Beschreibung.

    Wir haben uns in jeder Auswertung jeweils auf die Verwendung von entweder Codes oder Beschreibungen beschränkt, weshalb dies keinen Einfluss auf die Auswertungen hat.

3. Transformation & Bearbeitung

Aufbereitung / Umcodierung

Im folgenden werden die im vorherigen Abschnitt beschrieben Auffälligkeiten der Daten angepasst.

# Aufbereitung der Liste mit Codes zur Zuordnung der Modus Operandi
codes_to_numeric <- function(x) {
  if (is.na(x)) {
    return(NA)
  } else {
    return(as.numeric(strsplit(x, " ")[[1]]))
  }
}

# Transformation der Daten zu sinnvollen Datentypen
crimes.df <- transform(crimes.df.raw,
  `Date Rptd` = as.Date(substr(`Date Rptd`, 1, 10), format = "%m/%d/%Y"),
  `DATE OCC` = as.Date(substr(`DATE OCC`, 1, 10), format = "%m/%d/%Y"),
  `TIME OCC` = as.integer(`TIME OCC`),
  `AREA` = as.integer(`AREA`),
  `Rpt Dist No` = as.integer(`Rpt Dist No`),
  `Crm Cd` = as.integer(`Crm Cd`),
  `Mocodes` = lapply(Mocodes, codes_to_numeric)
)
crmCd.diff <- which(crimes.df["Crm Cd"] != crimes.df["Crm Cd 1"])
length(crmCd.diff)
[1] 1956

Hier ist zu sehen, dass 1956 Werte der Primären Crime Codes nicht miteinander übereinstimmen. Da alle unserer Analysen mit der Hauptstraftat arbeiten, ist dies jedoch nicht für die Analyse relevant.

# Überprüfen, ob die Spalte nur NAs enthält
if (all(is.na(crimes.df[["Crm Cd 4"]]))) {
  crimes.df[["Crm Cd 4"]] <- NULL
  print("Spalte Crm Cd 4 wurde entfernt, da sie keine Werte enthält.")
}
[1] "Spalte Crm Cd 4 wurde entfernt, da sie keine Werte enthält."
# Löschen von Part 1-2
crimes.df[["Part 1-2"]] <- NULL

Die Spalte ‘Part 1-2’ hat keine offizielle Beschreibung und wir konnten ihr keine Bedeutung zuordnen, weshalb sie entfernt wird.

Alle Kategorien in eine Tabelle

categories <- rbind(missing_categories, crmcd.categories)

Dem Datensatz wurden 28 Kategorien an Verbrechen zugeordnet

rm(codes_to_numeric, missing_categories, crmcd.categories)

Verbinden von MO & dem Datensatz

crimes.df.joined <- crimes.df %>%
  mutate(`MoCd Desc` = map(Mocodes, ~ mocodes.df$Beschreibung[match(.x, mocodes.df$Code)])) %>%
  relocate(`MoCd Desc`, .after = `Mocodes`)

crimes.df.joined %>%
  mutate(
    codes_str = map_chr(Mocodes, ~ paste(.x, collapse = ", ")),
    meanings_str = map_chr(`MoCd Desc`, ~ paste(.x, collapse = ", "))
  ) %>%
  select(DR_NO, codes_str, meanings_str) %>%
  head()
      DR_NO             codes_str
1 190326475                    NA
2 200106753       1822, 1402, 344
3 200320258             344, 1251
4 200907217             325, 1501
5 220614831 1822, 1501, 930, 2004
6 231808869   1822, 100, 930, 929
                                                                                                                                    meanings_str
1                                                                                                                                             NA
2                                                                                   Stranger, Evidence Booked (any crime), Removes vict property
3                                                                                                    Removes vict property, Victim was a student
4                                                                                                           Took merchandise, Other MO (see rpt)
5                          Stranger, Other MO (see rpt), Unauthorized use of victim's credit/debit card or number, Suspect is homeless/transient
6 Stranger, Suspect Impersonate, Unauthorized use of victim's credit/debit card or number, Unauthorized use of victim's bank account information

Subsetting

Wir haben auf ein generelles Subsetting der Daten verzichtet, um die tatsächliche Anzahl an Verbrechen im behandelten Zeitraum nicht zu verzerren. Es findet jedoch abhängig von der Analyse ein Subsetting basierend auf den Bezirken, Uhrzeiten und weiteren Eigenschaften statt.

Übersicht des Dataframes

glimpse(crimes.df.joined)
Rows: 986,500
Columns: 27
$ DR_NO            <dbl> 190326475, 200106753, 200320258, 200907217, 220614831…
$ `Date Rptd`      <date> 2020-03-01, 2020-02-09, 2020-11-11, 2023-05-10, 2022…
$ `DATE OCC`       <date> 2020-03-01, 2020-02-08, 2020-11-04, 2020-03-10, 2020…
$ `TIME OCC`       <int> 2130, 1800, 1700, 2037, 1200, 2300, 900, 1110, 1400, …
$ AREA             <int> 7, 1, 3, 9, 6, 18, 1, 3, 13, 19, 18, 19, 2, 10, 3, 18…
$ `AREA NAME`      <chr> "Wilshire", "Central", "Southwest", "Van Nuys", "Holl…
$ `Rpt Dist No`    <int> 784, 182, 356, 964, 666, 1826, 182, 303, 1375, 1974, …
$ `Crm Cd`         <int> 510, 330, 480, 343, 354, 354, 354, 354, 354, 624, 354…
$ `Crm Cd Desc`    <chr> "VEHICLE - STOLEN", "BURGLARY FROM VEHICLE", "BIKE - …
$ Mocodes          <list> NA, <1822, 1402, 344>, <344, 1251>, <325, 1501>, <18…
$ `MoCd Desc`      <list> NA, <"Stranger", "Evidence Booked (any crime)", "Rem…
$ `Vict Age`       <dbl> 0, 47, 19, 19, 28, 41, 25, 27, 24, 26, 26, 8, 7, 0, 5…
$ `Vict Sex`       <chr> "M", "M", "X", "M", "M", "M", "M", "F", "F", "M", "M"…
$ `Vict Descent`   <chr> "O", "O", "X", "O", "H", "H", "H", "B", "B", "H", "B"…
$ `Premis Cd`      <dbl> 101, 128, 502, 405, 102, 501, 502, 248, 750, 502, 501…
$ `Premis Desc`    <chr> "STREET", "BUS STOP/LAYOVER (ALSO QUERY 124)", "MULTI…
$ `Weapon Used Cd` <dbl> NA, NA, NA, NA, NA, NA, NA, NA, NA, 400, NA, 400, 400…
$ `Weapon Desc`    <chr> NA, NA, NA, NA, NA, NA, NA, NA, NA, "STRONG-ARM (HAND…
$ Status           <chr> "AA", "IC", "IC", "IC", "IC", "IC", "IC", "IC", "IC",…
$ `Status Desc`    <chr> "Adult Arrest", "Invest Cont", "Invest Cont", "Invest…
$ `Crm Cd 1`       <dbl> 510, 330, 480, 343, 354, 354, 354, 354, 354, 624, 354…
$ `Crm Cd 2`       <dbl> 998, 998, NA, NA, NA, NA, NA, NA, NA, NA, NA, 821, 86…
$ `Crm Cd 3`       <dbl> NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, N…
$ LOCATION         <chr> "1900 S  LONGWOOD                     AV", "1000 S  F…
$ `Cross Street`   <chr> NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, "…
$ LAT              <dbl> 34.0375, 34.0444, 34.0210, 34.1576, 34.0944, 33.9467,…
$ LON              <dbl> -118.3506, -118.2628, -118.3002, -118.4387, -118.3277…

Fazit - Transformation & Bearbeitung

Die Daten entsprechen größtenteils unseren Vermutungen, jedoch gibt es kleine Unstimmigkeiten innerhalb des Datensatzes. Diese betreffen jedoch Informationen, welche keinen Einfluss auf die Analyse der Daten haben und konnten deshalb, je nach Fall, entfernt oder ignoriert werden.

4. Geeignete Visualisierung und Aggregation der Daten

  • Welche Klassen von Straftaten werden wie häufig begangen?
    • Anzahl Proportional zu Schweregrad
    • Viele Diebstahle & andere Straftaten um Geld zu beschaffen
  • Welche Stadtteile sind besonders betroffen?
    • Ärmere Stadtteile
    • Stadtteile mit Gang Gebieten
crimes.tib <- as_tibble(crimes.df)

Ortsabhängige Analysen

crimes.df.no_id_theft <- subset(crimes.df, `Crm Cd` != 354)
nrow(crimes.df.no_id_theft)
[1] 925352
crimes.df.no_id_theft <- crimes.df.no_id_theft[sample(nrow(crimes.df.no_id_theft), 5000), ]
leaflet(crimes.df.no_id_theft) %>%
  addTiles() %>% # Standard-OSM-Karte
  setView(lng = -118.2437, lat = 34.0522, zoom = 9) %>% # Ansicht auf Los Angeles
  addCircleMarkers(~LON, ~LAT,
    radius = 5,
    color = "blue",
    stroke = FALSE,
    fillOpacity = 0.8,
    popup = ~ paste("ID:", `Crm Cd Desc`)
  )

Hier ist eine Übersicht von den Orten von 5000 zufällig ausgewählten Straftaten zu sehen, um einen groben Überblick zu schaffen. Man erkennt deutlich den länglichen Umriss der Stadt und kann sich durch die Auswahl einzelner Straftaten einen groben Eindruck über die Kriminalitätssituation machen

leaflet(crimes.df) %>%
  addTiles() %>% # Grundkarte hinzufügen
  setView(lng = -118.2437, lat = 34.0522, zoom = 9) %>%
  addHeatmap(
    lng = ~LON,
    lat = ~LAT,
    intensity = nrow(crimes.df),
    blur = 20,
    max = 0.05,
    radius = 10
  )

In Form dieses Heatmap wird deutlich, dass die ganze Stadt ähnlich stark von Straftaten betroffen ist. Es gibt keine Gebiete innerhalb des behandelten Bereichs, welche tief rot oder blau eingefärbt sind, was jeweils sehr vielen bzw. wenigen Straftaten entsprechen würde.

rm(crimes.df.no_id_theft)

Combine Categories with crimes.tib

unique(crimes.tib$`AREA NAME`)
 [1] "Wilshire"    "Central"     "Southwest"   "Van Nuys"    "Hollywood"  
 [6] "Southeast"   "Newton"      "Mission"     "Rampart"     "West Valley"
[11] "West LA"     "Olympic"     "Hollenbeck"  "Topanga"     "Northeast"  
[16] "77th Street" "Pacific"     "N Hollywood" "Harbor"      "Foothill"   
[21] "Devonshire" 
crimes.tib <- crimes.tib %>%
  mutate(`Crm Cd` = as.factor(`Crm Cd`))

crimes.tib <- merge(crimes.tib, categories, by = c("Crm Cd" = "Crm Cd"))

Top 15 Kategorien an Straftaten

category_count <- crimes.tib %>%
  group_by(`Category`) %>%
  summarise(count = n()) %>%
  arrange(desc(count))

top_categories <- category_count %>%
  mutate(Category = ifelse(row_number() <= 15, Category, "Others")) %>%
  group_by(Category) %>%
  summarise(count = sum(count)) %>%
  mutate(percentage = count / sum(count) * 100)

p <- ggplot(top_categories, aes(
  x = "", y = count, fill = Category,
  text = paste0(Category, ": ", round(percentage, 1), "%")
)) +
  geom_bar(stat = "identity", width = 1) +
  coord_polar(theta = "y") +
  labs(
    title = "Top 15 Categories of Crimes (Others Combined)",
    fill = "Category"
  ) +
  theme_void() +
  theme(
    axis.text.x = element_blank(),
    legend.position = "right"
  )

fig <- plot_ly(top_categories,
  labels = ~Category, values = ~count, type = "pie",
  textposition = "inside", textinfo = "percent",
  hoverinfo = "text",
  marker = list(colors = colors, line = list(color = "#FFFFFF", width = 1))
)

fig <- fig %>% layout(
  title = "Top 15 Kategorien an Straftaten (andere kombiniert)",
  xaxis = list(showgrid = FALSE, zeroline = FALSE, showticklabels = FALSE),
  yaxis = list(showgrid = FALSE, zeroline = FALSE, showticklabels = FALSE)
)

fig

Anhand der Verteilung der Straftatenkategorien ist zu sehen, dass keine einzelne Kategorie mit deutlichem Abstand heraussticht, sondern alle nur wenige Prozentpunkte auseinander liegen. Es ist jedoch auffällig, dass drei der Top 5 (Burglary/Theft from Vehicle, Other Theft, Grand Theft Auto) und sechs der Top 10 Kategorien (+ Personal Theft, Burglary, Robbery) Straftaten sind, welche mit Diebstahl zu tuen haben, also, dass der Täter sich berreichern wollte.

rm(category_count, top_categories, p, fig)

Prozentuale Verteilung der Verbrechen pro Stadtteil und Art des Verbrechens

crime_counts <- crimes.tib %>%
  group_by(`AREA NAME`, `Category`) %>%
  summarize(count = n()) %>%
  group_by(`AREA NAME`) %>%
  mutate(percentage = round(count / sum(count), digits = 5) * 100)

ggplotly(
  ggplot(crime_counts, aes(x = `AREA NAME`, y = percentage, fill = `Category`)) +
    geom_bar(stat = "identity") +
    labs(
      title = "Prozentuale Verteilung der Verbrechen pro Stadtteil und Art des Verbrechens",
      x = "Area Name",
      y = "Prozentsatz"
    ) +
    theme(axis.text.x = element_text(angle = 45, hjust = 1))
)

In diesem Diagramm ist zu sehen, dass es keine großen Unterschiede zwischen den verschiedenen Bezirken von Los Angeles gibt, wenn es um die Anteile an Straftatenklassen geht. Die Aufteilung ähnelt sich in allen Bezirken sehr.

rm(crime_counts)

Welche Stadtteile haben besonders viele Straftaten mit Gang Einfluss?

gang_crimes <- crimes.df.joined %>%
  filter(map_lgl(`MoCd Desc`, ~ any(grepl("[gG]ang", .x)))) %>%
  group_by(`AREA NAME`) %>%
  summarise(gang_count = n())

total_crimes <- crimes.df.joined %>%
  group_by(`AREA NAME`) %>%
  summarise(total_count = n())

crime_data <- left_join(total_crimes, gang_crimes, by = "AREA NAME") %>%
  replace_na(list(gang_count = 0))

crime_data <- crime_data %>%
  mutate(non_gang_count = total_count - gang_count)

crime_data_long <- crime_data %>%
  select(`AREA NAME`, gang_count, non_gang_count) %>%
  pivot_longer(
    cols = -`AREA NAME`,
    names_to = "crime_type",
    values_to = "count"
  )

crime_data_long <- crime_data_long %>%
  mutate(crime_type = factor(crime_type, levels = c("non_gang_count", "gang_count")))

crime_data_long <- crime_data_long %>%
  arrange(desc(ifelse(crime_type == "gang_count", count, -Inf))) %>%
  mutate(`AREA NAME` = factor(`AREA NAME`, levels = unique(`AREA NAME`)))

ggplot(crime_data_long, aes(x = `AREA NAME`, y = count, fill = crime_type)) +
  geom_bar(stat = "identity") +
  scale_fill_manual(
    values = c("gang_count" = "steelblue", "non_gang_count" = "gray"),
    labels = c("Non-Gang-Related", "Gang-Related")
  ) +
  labs(
    title = "Number of Gang-Related vs. Non-Gang-Related Crimes by Area",
    x = "Area Name",
    y = "Number of Crimes",
    fill = "Crime Type"
  ) +
  theme_minimal() +
  theme(axis.text.x = element_text(angle = 45, hjust = 1))

Zu sehen sind hier die Anteile der Straftaten, welche im Modus Operandi eine Bemerkung mit ‘Gang’ enthalten, bezogen auf die Bezirke der Stadt. Die X Achse ist nach Anzahl an Gang Straftaten sortiert und anhandder grauen Balken ist ein Vergleich zum Rest der Straftaten möglich. Es wird deutlich, dass der Anteil der Gang Straftaten stark variiert, jedoch in keinem der Bezirke einen deutlichen Anteil einnehmen.

rm(gang_crimes, total_crimes, crime_data, crime_data_long)

Gibt es besonders Gefährliche Arten von Orten ([Premise Desc])

premis.grouped <- crimes.df %>%
  group_by(`Premis Cd`, `Premis Desc`) %>%
  summarise(count = n() / 1000) %>%
  arrange(desc(count)) %>%
  ungroup() %>%
  # Remove parenthesis from descriptions
  mutate(`Premis Desc` = gsub("\\s*\\([^\\)]+\\)", "", `Premis Desc`))

ggplot(
  premis.grouped[1:20, ],
  aes(
    x = fct_reorder(`Premis Desc`, count, .desc = T),
    y = `count`
  )
) +
  geom_point(size = 3) +
  geom_segment(aes(
    x = `Premis Desc`,
    xend = `Premis Desc`,
    y = 0,
    yend = `count`
  )) +
  labs(
    title = "Straftaten an Orten",
    subtitle = "Anzahl an Straftaten an einer bestimmten Art von Ort",
    x = "Ortstype",
    y = "Anzahl der Straftaten [in Tsd.]"
  ) +
  scale_x_discrete(labels = function(x) str_wrap(x, width = 20)) +
  theme_tufte() +
  theme(axis.text.x = element_text(angle = 65, vjust = 0.6))

rm(premis.grouped)

Anhand dieses Lolipop Charts wird Sichtbar, wie viele Straftaten an bestimmten Arten von Orten begangen werden. Dabei ist Sichtbar, dass mit Abstand die meisten Straftaten auf offener Straße verübt werden, darauf folgen zwei Arten von Wohnungen.

Personenabhängige Analysen

Welche Bevölkerungsgruppe ist am meisten gefährdet? (Abhängig von Alter, Geschlecht, Abstammung)

# Filter and summarize the data with age groups
crimes.df.sex.age <- crimes.df %>%
  filter(`Vict Sex` %in% c("M", "F"), `Vict Age` >= 1) %>%
  mutate(Age_Group = cut(`Vict Age`,
    breaks = seq(0, max(`Vict Age`, na.rm = TRUE) + 5, 5),
    labels = paste(seq(1, max(`Vict Age`, na.rm = TRUE), by = 5),
      seq(5, max(`Vict Age`, na.rm = TRUE) + 4, by = 5),
      sep = "-"
    ),
    include.lowest = TRUE
  )) %>%
  group_by(Age_Group, `Vict Sex`) %>%
  summarise(count = n()) %>%
  ungroup()

# Define custom y-axis breaks for symmetrical pyramid
brks <- seq(-50000, 50000, by = 10000)
lbls <- abs(brks)

ggplot(crimes.df.sex.age, aes(x = Age_Group, y = count, fill = `Vict Sex`)) +
  geom_bar(
    data = subset(crimes.df.sex.age, `Vict Sex` == "M"),
    aes(y = -count), stat = "identity", width = 0.6
  ) +
  geom_bar(
    data = subset(crimes.df.sex.age, `Vict Sex` == "F"),
    stat = "identity", width = 0.6
  ) +
  scale_y_continuous(breaks = brks, labels = lbls) +
  coord_flip() +
  labs(title = "Altersverteilung der Opfer abhängig vom Geschlecht") +
  theme_tufte() +
  theme(
    plot.title = element_text(hjust = .5),
    axis.ticks = element_blank()
  ) +
  scale_fill_brewer(palette = "Dark2")

Anhand dieser Populations Pyramide bezogen auf Verbrechen lässt sich ein relativ symmetrisches Muster zwischen Männern und Frauen erkennen. Beide Geschlechter haben die meisten Opfer zwischen 26 und 35 Jahren.

rm(crimes.df.sex.age, brks, lbls)

Zeitliche Analysen

Wie hat sich die Kriminalität über die 3 Jahre verändert?

top_categories <- crimes.tib %>%
  group_by(Category) %>%
  summarize(total_count = n(), .groups = "drop") %>%
  arrange(desc(total_count)) %>%
  slice_head(n = 15)

# Daten aufteilen in Top 15 und Rest
top15_data <- crimes.tib %>%
  filter(Category %in% top_categories$Category)

rest_data <- crimes.tib %>%
  filter(!Category %in% top_categories$Category)

# Monat und Jahr extrahieren
top15_data$Month_Year <- format(top15_data$`DATE OCC`, "%Y-%m")
rest_data$Month_Year <- format(rest_data$`DATE OCC`, "%Y-%m")

# Gruppieren nach Monat und Kategorie
top15_per_time <- top15_data %>%
  group_by(Month_Year, Category) %>%
  summarize(count = n(), .groups = "drop")

rest_per_time <- rest_data %>%
  group_by(Month_Year, Category) %>%
  summarize(count = n(), .groups = "drop")

# Sortiere die Zeitachse
top15_per_time$Month_Year <- factor(top15_per_time$Month_Year, levels = sort(unique(top15_per_time$Month_Year)))
rest_per_time$Month_Year <- factor(rest_per_time$Month_Year, levels = sort(unique(rest_per_time$Month_Year)))

# Plot für Top 15 Kategorien
plot_top15 <- ggplot(
  top15_per_time,
  aes(x = Month_Year, y = count, color = Category, group = Category)
) +
  geom_line() +
  labs(
    title = "Top 15 Crime Categories Over Time",
    x = "Time (Month-Year)",
    y = "Number of Crimes"
  ) +
  scale_x_discrete(
    breaks = unique(top15_per_time$Month_Year)[seq(1, length(unique(top15_per_time$Month_Year)), by = 3)],
    labels = unique(top15_per_time$Month_Year)[seq(1, length(unique(top15_per_time$Month_Year)), by = 3)]
  ) +
  theme_minimal() +
  theme(axis.text.x = element_text(angle = 45, hjust = 1))

# Plot für restliche Kategorien
plot_rest <- ggplot(
  rest_per_time,
  aes(x = Month_Year, y = count, color = Category, group = Category)
) +
  geom_line() +
  labs(
    title = "Rest of the Crime Categories Over Time",
    x = "Time (Month-Year)",
    y = "Number of Crimes"
  ) +
  scale_x_discrete(
    breaks = unique(rest_per_time$Month_Year)[seq(1, length(unique(rest_per_time$Month_Year)), by = 3)],
    labels = unique(rest_per_time$Month_Year)[seq(1, length(unique(rest_per_time$Month_Year)), by = 3)]
  ) +
  theme_minimal() +
  theme(axis.text.x = element_text(angle = 45, hjust = 1))

# Interaktive Diagramme mit ggplotly
plotly_top15 <- ggplotly(plot_top15)
plotly_rest <- ggplotly(plot_rest)

# Diagramme anzeigen
plotly_top15
plotly_rest

Diese zwei Plots stellen die Anzahl an Straftaten im zeitlichen Verlauf des Datensatzes dar. Der Starke Abfall aller Kategorien am Ende lässt sich darauf zurückschließen, dass die Daten auf der Digitalisierung von Akten beruhen und die neusten Akten noch nicht enthalten sind.

An den meisten verläufen lässt sich kein klares Muster erkennen. Ausnahmen bilden hierbei die einfache Körperverletzung, welche in jedem Sommer ansteigt, und ‘Personal Theft’ was über das ganze Jahr 2022 deutlich höhere Werte verzeichnet.

rm(top_categories, top15_data, rest_data, top15_per_time, rest_per_time, plot_top15, plot_rest, plotly_top15, plotly_rest)

Gibt es zeitliche Rahmen in denen mehr oder weniger Verbrechen geschehen?

num_days <- crimes.df.joined %>%
  summarize(num_days = n_distinct(`DATE OCC`)) %>%
  pull(num_days)

crimes_by_hour <- crimes.df.joined %>%
  mutate(time_rounded = round(`TIME OCC` / 100) * 100) %>%
  group_by(time_rounded) %>%
  summarize(count = n()) %>%
  mutate(count = round((count - mean(count))/num_days, 2)) %>%
  mutate(lower_higher = ifelse(count < 0, "lower", "higher")) %>%
  mutate(time_rounded = factor(time_rounded, levels = seq(0, 2300, by = 100))) %>%
  filter(!is.na(time_rounded))

ggplot(crimes_by_hour, aes(x = time_rounded, y = count, label = "Straftaten zu Uhrzeit")) +
  geom_bar(stat = "identity", aes(fill = lower_higher), width = .5) +
  scale_fill_manual(
    name = "Anzahl Straftaten",
    labels = c("Über Durchschnitt", "Unter Durchschnitt"),
    values = c("lower" = "#00ba38", "higher" = "#f8766d")
  ) +
  labs(
    title = "Straftaten nach Uhrzeit",
    subtitle = "Summe der Straftaten zu bestimmten Uhrzeiten",
    x = "Uhrzeit (gerundet auf ganze Stunden)",
    y = "Durchschnittliche tägliche Differenz zum Durchschnitt der Uhrzeiten"
  ) +
  coord_flip() +
  theme_bw()

Im stündlichen Vergleich wird klar, dass die meisten Straftaten Nachmittags bis zum späten Abend zwischen 14 Uhr und 23 Uhr begangen werden. Hierbei stellt 12 Uhr einen Ausnahmefall dar, was entweder daran liegen könnte, dass Beispielsweise während der Mittagspause Verbrechen begangen werden, es kann jedoch auch sein, dass 12 Uhr als Standard in der Datenbank hinterlegt ist, was die Zahl künstlich verfälscht.

rm(num_days, crimes_by_hour)

Analysen der Straftaten

Welche Arten von Waffen wird am meisten genutzt?

weapon_count <- crimes.tib %>%
  group_by(`Weapon Desc`) %>%
  summarise(count = n()) %>%
  arrange(desc(count))

top_weapons <- weapon_count %>%
  filter(!is.na(`Weapon Desc`)) %>%
  mutate(weapon = ifelse(row_number() <= 10, `Weapon Desc`, "Others")) %>%
  group_by(weapon) %>%
  summarise(count = sum(count))

top_weapons$percentage <- round((top_weapons$count / sum(top_weapons$count)) * 100, 1)

top_weapons$weapon <- factor(top_weapons$weapon, levels = top_weapons$weapon[order(top_weapons$count, decreasing = TRUE)])

ggplot(top_weapons, aes(x = "", y = count, fill = weapon)) +
  geom_bar(stat = "identity", width = 1) +
  coord_polar(theta = "y") +
  labs(
    title = "Top 10 Most Used Weapons (Others Combined)",
    fill = "Weapon"
  ) +
  theme_void() +
  theme(
    axis.text.x = element_blank(),
    legend.position = "right"
  ) +
  geom_text(aes(label = ifelse(percentage > 5, paste0(percentage, "%"), "")),
    position = position_stack(vjust = 0.5), size = 5
  )

Bei den meistgenutzten Waffen lässt sich deutlich erkennen, dass die meisten Straftaten, ohne direkte Waffengewalt durchgeführt werden, sondern mit reiner Körperkraft.

rm(weapon_count, top_weapons)

Wie viel Prozent haben zu Verhaftungen (und welcher Art) geführt?

status.df <- as.data.frame(table(crimes.df$`Status Desc`))
colnames(status.df) <- c("Status", "Count")

status.df$Percentage <- round((status.df$Count / sum(status.df$Count)) * 100, 1)

# Create the pie chart with percentage labels
ggplot(status.df, aes(x = "", y = Count, fill = Status)) +
  geom_bar(stat = "identity", width = 1) +
  coord_polar("y", start = 0) +
  theme_void() +
  labs(title = "Distribution of Status Desc Values") +
  geom_text(aes(label = ifelse(Percentage > 5, paste0(Percentage, "%"), "")),
    position = position_stack(vjust = 0.5), size = 5
  )

Die Verhaftungsrate des Los Angeles Police Department beträgt lediglich bei 8,7%. Knapp 80% der Fälle werden noch Untersucht, wobei viele der Fälle aufgrund der Zeitspanne der Daten schon mehrere Jahre alt sind.

rm(status.df)

5. Zusammenfassung und Schlussfolgerung

Aufgabenstellung (10 Pkt.)

Fassen Sie hier Ihre Fragestellung und Ihre Erkenntnisse aus Ihrer Analyse zusammen.

Sind Ihre Erkenntnisse das, was Sie erwartet haben? Warum oder warum nicht?

// todo Julia

Quellenverzeichnis

Bibliotheken

Datensatz